home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1996 / MacHack 1996.toast / Hacks / Hacks ’87 / Source ƒ.sit / Source ƒ / XLISP ƒ / XLISP 1.7 C SRCS / xlisp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1986-07-03  |  2.9 KB  |  139 lines
  1. /* xlisp - a small implementation of lisp with object-oriented programming */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* define the banner line string */
  9. #define BANNER    "XLISP version 1.7, Copyright (c) 1986, by David Betz"
  10.  
  11. /* external variables */
  12. extern NODE *s_stdin,*s_stdout;
  13. extern NODE *s_evalhook,*s_applyhook;
  14. extern int xldebug;
  15. extern NODE *true;
  16. extern FILE *tfp;
  17.  
  18. /* external routines */
  19. extern FILE *fopen();
  20.  
  21. /* main - the main routine */
  22. main(argc,argv)
  23.   int argc; char *argv[];
  24. {
  25.     char *transcript;
  26.     int verbose,i;
  27.     CONTEXT cntxt;
  28.     NODE *expr;
  29.  
  30.     /* setup default argument values */
  31.     transcript = NULL;
  32.     verbose = FALSE;
  33.  
  34.     /* parse the argument list switches */
  35. #ifndef MEGAMAX
  36.     for (i = 1; i < argc; ++i)
  37.     if (argv[i][0] == '-')
  38.         switch(argv[i][1]) {
  39.         case 't':
  40.         case 'T':
  41.         transcript = &argv[i][2];
  42.         break;
  43.         case 'v':
  44.         case 'V':
  45.         verbose = TRUE;
  46.         break;
  47.         }
  48. #endif
  49.  
  50.     /* initialize and print the banner line */
  51.     osinit(BANNER);
  52.  
  53.     /* open the transcript file */
  54.     if (transcript && (tfp = fopen(transcript,"w")) == NULL)
  55.     printf("can't open transcript file: %s\n",transcript);
  56.  
  57.     /* setup initialization error handler */
  58.     xlbegin(&cntxt,CF_TOPLEVEL|CF_ERROR,(NODE *) 1);
  59.     if (setjmp(cntxt.c_jmpbuf)) {
  60.     printf("fatal initialization error\n");
  61.     wrapup();
  62.     }
  63.  
  64.     /* initialize xlisp */
  65.     xlinit();
  66.     xlend(&cntxt);
  67.  
  68.     /* reset the error handler */
  69.     xlbegin(&cntxt,CF_TOPLEVEL|CF_ERROR,true);
  70.  
  71.     /* load "init.lsp" */
  72.     if (setjmp(cntxt.c_jmpbuf) == 0)
  73.     xlload("init.lsp",FALSE,FALSE);
  74.  
  75.     /* load any files mentioned on the command line */
  76. #ifndef MEGAMAX
  77.     if (setjmp(cntxt.c_jmpbuf) == 0)
  78.     for (i = 1; i < argc; i++)
  79.         if (argv[i][0] != '-' && !xlload(argv[i],TRUE,verbose))
  80.         xlfail("can't load file");
  81. #endif
  82.  
  83.     /* create a new stack frame */
  84.     xlsave1(expr);
  85.  
  86.     /* main command processing loop */
  87.     while (TRUE) {
  88.  
  89.     /* setup the error return */
  90.     if (i = setjmp(cntxt.c_jmpbuf)) {
  91.         if (i == CF_TOPLEVEL)
  92.         stdputstr("[ back to the top level ]\n");
  93.         setvalue(s_evalhook,NIL);
  94.         setvalue(s_applyhook,NIL);
  95.         xldebug = 0;
  96.         xlflush();
  97.     }
  98.  
  99.     /* read an expression */
  100.     if (!xlread(getvalue(s_stdin),&expr,FALSE))
  101.         break;
  102.  
  103.     /* evaluate the expression */
  104.     expr = xleval(expr);
  105.  
  106.     /* print it */
  107.     stdprint(expr);
  108.     }
  109.     xlend(&cntxt);
  110.  
  111.     /* clean up */
  112.     wrapup();
  113. }
  114.  
  115. /* stdprint - print to standard output */
  116. stdprint(expr)
  117.   NODE *expr;
  118. {
  119.     xlprint(getvalue(s_stdout),expr,TRUE);
  120.     xlterpri(getvalue(s_stdout));
  121. }
  122.  
  123. /* stdputstr - print a string to standard output */
  124. stdputstr(str)
  125.   char *str;
  126. {
  127.     xlputstr(getvalue(s_stdout),str);
  128. }
  129.  
  130. /* wrapup - clean up and exit to the operating system */
  131. wrapup()
  132. {
  133.     if (tfp)
  134.     fclose(tfp);
  135.     osfinish();
  136.     exit(0);
  137. }
  138.  
  139.